home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Boot / bitvector.em next >
Encoding:
Text File  |  1993-06-30  |  1.5 KB  |  69 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: bitvectors.em
  4. ;; Date: Tue Jun 29 22:57:10 1993
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;
  9.  
  10. (defmodule bitvector
  11.   (bit-vectors
  12.    telos1
  13.    macros0
  14.    extras0
  15.    defs
  16.    init
  17.    gens
  18.    )
  19.   ()
  20.   
  21.   (defclass <bit-vector> (<sequence>)
  22.     ((self accessor bits))
  23.     direct-initargs (size fill)
  24.     )
  25.  
  26.   (defmethod initialize ((x <bit-vector>) args)
  27.     (let ((new (call-next-method))
  28.       (size (scan-args 'size args required-argument))
  29.       (fill-val (scan-args 'fill args null-argument)))
  30.       ((setter bits) new (primitive-make-bit-vector size))
  31.       (when (eql fill-val 1)
  32.     (fill new 1 0 (- size 1)))
  33.       new))
  34.   
  35.   (defmethod element ((bv <bit-vector>) s)
  36.     (primitive-bit-vector-ref (bits bv) s)
  37.     bv)
  38.  
  39.   (defmethod (setter element) ((bv <bit-vector>) s v)
  40.     ((setter primitive-bit-vector-ref) (bits bv) s v)
  41.     bv)
  42.   
  43.   (defmethod size ((bv <bit-vector>))
  44.     (bit-vector-length (bits bv)))
  45.  
  46.   (defmethod current-key ((c <bit-vector>) (s <fixint>)) s)
  47.   
  48.   (defmethod clone ((x <bit-vector>))
  49.     (make <bit-vector> 'size x))
  50.  
  51.   (defmethod (converter <bitvector>) ((x <fixint>))
  52.     (let ((tmp (make <bit-vector> 'size 0)))
  53.       ((setter bits) tmp
  54.        (integer-to-bitvector x))
  55.       tmp))
  56.   
  57.   (defmethod generic-prin ((bv <bit-vector>) s)
  58.     (format s "#[~a (~a) ~l]"
  59.         (symbol-unbraced-name (class-name (class-of x)))
  60.         (size x)
  61.         (lambda (bv s)
  62.           (do (lambda (x)
  63.             (generic-prin x s))
  64.           bv))
  65.         bv))
  66.  
  67.   ;; end module
  68.   )
  69.